perm filename FPRINT.IL[TIM,LSP] blob sn#735362 filedate 1983-12-12 generic text, type T, neo UTF8
(FILECREATED " 5-JUL-83 14:29:33" {PHYLUM}<GABRIEL>FPRINT.;4 2137   

      changes to:  (VARS FPRINTCOMS TESTATOMS)
		   (FNS FPRINT INIT INIT1)

      previous date: " 5-JUL-83 14:13:19" {PHYLUM}<GABRIEL>FPRINT.;3)


(PRETTYCOMPRINT FPRINTCOMS)

(RPAQQ FPRINTCOMS ((FNS INIT INIT1 FPRINT)
		   (VARS TESTATOMS (TESTPATTERN (INIT 6 6 TESTATOMS)))
		   (P (COND ((INFILEP (QUOTE FPRINT.TST)))
			    (T (PROG ((F (OPENFILE (QUOTE FPRINT.TST)
						   (QUOTE OUTPUT))))
				     (PRINT TESTPATTERN F)
				     (CLOSEF F)))))
		   (GLOBALVARS TESTATOMS TESTPATTERN)))
(DEFINEQ

(INIT
  (LAMBDA (M N ATOMS)                                        (* JonL " 5-JUL-83 13:47")
    (PROG ((ATOMS (SUBST NIL NIL ATOMS)))
	   (RETURN (INIT1 M N
			  (bind (A ← ATOMS)
				do 
				(pop A)
				until (NULL (CDR A)) finally 
				(RETURN (RPLACD A ATOMS))))))
))

(INIT1
  (LAMBDA (M N ATOMS)                                        (* JonL " 5-JUL-83 13:26")
    (COND
      ((ZEROP M)
	(POP ATOMS))
      (T (bind A for I from N by -2 until (ILESSP I 1)
	    do (push A (pop ATOMS))
	       (push A (INIT1 (SUB1 M)
			      N ATOMS))
	    finally (RETURN A))))))

(FPRINT
  (LAMBDA NIL                                                (* JonL " 5-JUL-83 14:24")
    (PROG ((F (INFILEP (QUOTE FPRINT.TST))))
          (COND
	    (F (DELFILE F)))
          (SETQ F (OPENFILE (QUOTE FPRINT.TST)
			    (QUOTE OUTPUT)))
          (PRINT TESTPATTERN F)
          (RETURN (CLOSEF F)))))
)

(RPAQQ TESTATOMS (ABCDEF12 CDEFGH23 EFGHIJ34 GHIJKL45 IJKLMN56 KLMNOP67 MNOPQR78 OPRST89 QRSTUV90 
			   STUVWX01 UVWXYZ12 WXYZAB23 XYZABC34 123456AB 234567BC 345678CD 456789DE 
			   567890EF 678901FG 789012GH 890123HI))

(RPAQ TESTPATTERN (INIT 6 6 TESTATOMS))
(COND ((INFILEP (QUOTE FPRINT.TST)))
      (T (PROG ((F (OPENFILE (QUOTE FPRINT.TST)
			     (QUOTE OUTPUT))))
	       (PRINT TESTPATTERN F)
	       (CLOSEF F))))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS TESTATOMS TESTPATTERN)
)
(PUTPROPS FPRINT COPYRIGHT (NONE))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (574 1564 (INIT 584 . 881) (INIT1 883 . 1238) (FPRINT 1240 . 1562)))))
STOP